Challenge Data Visualisation 2024
Equipe BBM
2024-12-03
suppressMessages({
suppressWarnings({
# Définir les noms des tables
table_names <- c("usagers", "vehicules", "lieux", "caract")
# Définir les URL des fichiers CSV
urls <- c(
"https://www.data.gouv.fr/fr/datasets/r/68848e2a-28dd-4efc-9d5f-d512f7dbe66f",
"https://www.data.gouv.fr/fr/datasets/r/146a42f5-19f0-4b3e-a887-5cd8fbef057b",
"https://www.data.gouv.fr/fr/datasets/r/8bef19bf-a5e4-46b3-b5f9-a145da4686bc",
"https://www.data.gouv.fr/fr/datasets/r/104dbb32-704f-4e99-a71e-43563cb604f2"
)
# Fonction pour télécharger et lire les fichiers CSV
download_and_read_csv <- function(url) {
# Télécharger le fichier CSV
temp_file <- tempfile(fileext = ".csv")
download.file(url, temp_file, mode = "wb")
# Lire le fichier CSV
data <- read_csv2(temp_file)
return(data)
}
# Télécharger et nommer les tables des fichiers CSV
for (i in 1:length(urls)) {
assign(table_names[i], download_and_read_csv(urls[i])) # Nommer les tables selon les spécifications
}
})
})usagers_vehicules <- usagers %>%
inner_join(vehicules, by = c("Num_Acc", "id_vehicule"))
usagers_vehicules_lieux <- usagers_vehicules %>%
inner_join(lieux, by = "Num_Acc")## Warning in inner_join(., lieux, by = "Num_Acc"): Detected an unexpected many-to-many relationship between `x` and `y`.
## ℹ Row 1 of `x` matches multiple rows in `y`.
## ℹ Row 3 of `y` matches multiple rows in `x`.
## ℹ If a many-to-many relationship is expected, set `relationship =
## "many-to-many"` to silence this warning.usagers_vehicules_lieux_caract <- usagers_vehicules_lieux %>%
inner_join(caract, by = "Num_Acc")
merged_data <- usagers_vehicules_lieux_caract
merged_data <- subset(merged_data, grav != 0 & grav!=-1)merged_data$id_accident <- paste0(merged_data$Num_Acc, merged_data$id_usager)
vroum <- merged_data %>%
filter(catv %in% c("7"))
# Reformater Num_Acc pour ne garder que les 6 derniers chiffres
vroum <- vroum %>%
mutate(Num_Acc = substr(as.character(Num_Acc), nchar(as.character(Num_Acc)) - 5, nchar(as.character(Num_Acc))))
# 1. Créer une nouvelle table avec les colonnes id_usager, Num_Acc et catu
vroum_clean <- vroum %>%
select(id_usager, Num_Acc, catu) %>%
distinct() # Pour supprimer les doublons dans le couple (id_usager, catu)
# 2. Vérifier pour chaque Num_Acc si un piéton (catu == 3) et un conducteur (catu == 1) sont impliqués
# Créer une colonne pour savoir si un accident a un piéton, une voiture ou uniquement des piétons
accident_check <- vroum_clean %>%
group_by(Num_Acc) %>%
summarise(
piéton_present = any(catu == 3), # Il y a un piéton si catu == 3
voiture_present = any(catu == 1), # Il y a une voiture si catu == 1
only_pietons = all(catu == 3) # Tous les usagers sont des piétons si catu == 3 pour toutes les lignes
)
# 3. Filtrer les accidents qui ont à la fois un piéton et un conducteur, ou uniquement des piétons
accidents_to_remove <- accident_check %>%
filter((piéton_present == TRUE & voiture_present == TRUE) | only_pietons == TRUE)
# 4. Supprimer tous les Num_Acc qui sont dans `accidents_to_remove`
vroum <- vroum %>%
filter(!Num_Acc %in% accidents_to_remove$Num_Acc)# Transformation de la colonne hrmn
vroum <- vroum %>%
mutate(
# Convertir hrmn en format heures, minutes, secondes
time = as.POSIXct(hrmn, format = "%H:%M:%S"),
hour = as.numeric(format(time, "%H")), # Extraire les heures
minute = as.numeric(format(time, "%M")), # Extraire les minutes
second = as.numeric(format(time, "%S")) # Extraire les secondes
) %>%
mutate(
# Arrondir l'heure selon les règles données
hour_adjusted = ifelse(
minute > 29 | (minute == 29 & second >= 30),
(hour + 1) %% 24, # Arrondir vers le haut, modulo 24 pour les heures > 23
hour
)
)
# Comptage du nombre d'accidents par heure arrondie
accidents_par_heure <- vroum %>%
group_by(hour_adjusted) %>%
summarise(nombre_accidents = n_distinct(Num_Acc)) %>%
arrange(hour_adjusted)#on crée une colonne jour
vroum <- vroum %>%
mutate(
date = as.Date(paste0("2023-", mois, "-", jour), format = "%Y-%m-%d"),
jour_semaine = weekdays(date) # Calculer le jour de la semaine
)# 1. Filtrer les données pour exclure les trajets non renseignés (0 et -1)
vroum_filtered <- vroum %>%
filter(trajet != 0 & trajet != -1)
# 2. Remplacer les valeurs de trajet par leur signification réelle
vroum_filtered <- vroum_filtered %>%
mutate(trajet = case_when(
trajet == 1 ~ "Domicile – travail",
trajet == 2 ~ "Domicile – école",
trajet == 3 ~ "Courses – achats",
trajet == 4 ~ "Utilisation professionnelle",
trajet == 5 ~ "Promenade – loisirs",
trajet == 9 ~ "Autre",
TRUE ~ "Inconnu" # Au cas où
))
# 3. Remplacer les valeurs de gravité par leur signification réelle
vroum_filtered <- vroum_filtered %>%
mutate(grav = case_when(
grav == 1 ~ "Indemne",
grav == 2 ~ "Tué",
grav == 3 ~ "Blessé hospitalisé",
grav == 4 ~ "Blessé léger",
TRUE ~ "Inconnu" # Au cas où
))
# 3. S'assurer qu'il n'y a pas de doublons dans les clés (id_usager et trajet)
vroum_filtered_unique <- vroum_filtered %>%
distinct(id_usager, trajet, .keep_all = TRUE)
# 4. Comptage par combinaison unique d'id_usager, trajet et gravité
grav_trajet_summary <- vroum_filtered_unique %>%
group_by(id_usager, trajet, grav) %>%
summarise(count = n(), .groups = 'drop')
# 5. Créer un tableau récapitulatif (pivot)
pivot_table <- grav_trajet_summary %>%
group_by(grav, trajet) %>%
summarise(total = sum(count), .groups = 'drop') %>%
pivot_wider(names_from = trajet, values_from = total, values_fill = list(total = 0))
# 7. Ajouter une colonne "total" pour chaque ligne (somme des différentes gravités)
pivot_table <- pivot_table %>%
mutate(total = rowSums(select(., -grav), na.rm = TRUE))# Supprimer les lignes où 'prof' == -1
vroum_type_terrain <- vroum %>%
filter(prof != -1)
# Vérifier l'unicité du couple id_usager & prof, mais conserver toutes les autres informations
vroum_type_terrain <- vroum_type_terrain %>%
group_by(id_usager, prof) %>%
slice(1) %>% # On garde seulement la première occurrence pour chaque couple unique
ungroup()
# 2. Remplacer les valeurs de 'prof' par leur signification réelle
vroum_type_terrain <- vroum_type_terrain %>%
mutate(prof = case_when(
prof == 1 ~ "Plat",
prof == 2 ~ "Pente",
prof == 3 ~ "Sommet de côte",
prof == 4 ~ "Bas de côte",
TRUE ~ "Inconnu" # Au cas où
))
# 3. Remplacer les valeurs de 'grav' par leur signification réelle
vroum_type_terrain <- vroum_type_terrain %>%
mutate(grav = case_when(
grav == 1 ~ "Indemne",
grav == 2 ~ "Tué",
grav == 3 ~ "Blessé hospitalisé",
grav == 4 ~ "Blessé léger",
TRUE ~ "Inconnu" # Au cas où
))
# 4. Comptage par combinaison unique d'id_usager, trajet et gravité
grav_pente_summary <- vroum_type_terrain %>%
group_by(id_usager, prof, grav) %>%
summarise(count = n(), .groups = 'drop')
# 5. Créer un tableau récapitulatif (pivot)
pivot_table_2 <- grav_pente_summary %>%
group_by(grav, prof) %>%
summarise(total = sum(count), .groups = 'drop') %>%
pivot_wider(names_from = grav, values_from = total, values_fill = list(total = 0))
# 7. Ajouter une colonne "total" pour chaque ligne (somme des différentes gravités)
pivot_table_2 <- pivot_table_2 %>%
mutate(total = rowSums(select(., -prof), na.rm = TRUE))
# 4. Lier le profil de la route à la gravité et créer un tableau de comptage
comptage_grav_prof <- vroum_type_terrain %>%
group_by(grav, prof) %>%
summarise(comptage = n(), .groups = "drop")# 1. Créer le tableau récapitulatif (pivot) avec les totaux par trajet et gravité
pivot_table_2 <- grav_pente_summary %>%
group_by(prof, grav) %>%
summarise(total = sum(count), .groups = 'drop') %>%
pivot_wider(names_from = grav, values_from = total, values_fill = list(total = 0))
# 2. Ajouter une colonne "total" pour chaque ligne (somme des différentes gravités)
pivot_table_2 <- pivot_table_2 %>%
mutate(total = rowSums(select(., -prof), na.rm = TRUE))
# 3. Calculer les pourcentages par rapport au total de chaque ligne
pivot_table_percentage_2 <- pivot_table_2 %>%
mutate(across(-c(prof, total), ~ round(. / total,3)*100, .names = " {.col}"))
# 4. Ne conserver que les colonnes "trajet", "total" et les pourcentages
pivot_table_percentage_2 <- pivot_table_percentage_2 %>%
select(prof, total, starts_with(" "))
# 5. Enlever la colonne "total" et afficher le tableau final avec les pourcentages
pivot_table_percentage_2 <- pivot_table_percentage_2 %>%
select(-total) # Retirer la colonne "total"vroum_grv3 <- vroum %>%
mutate(
Gravite = case_when(
grav == 1 ~ "Indemne",
grav == 2 ~ "Tué",
grav == 3 ~ "Hospitalisé",
grav == 4 ~ "Blessé_Léger",
TRUE ~ "Autre" # Si d'autres catégories existent
)
)
# Afficher un aperçu des données après recodage
vroum_grv3 <- vroum_grv3 %>%
mutate(grav = Gravite) %>%
select(-Gravite)
vroum_place <- vroum_grv3 %>%
mutate(
place_recoded = case_when(
place == 1 ~ "Conducteur",
place %in% c(2,6) ~ "Avant",
place %in% c(3, 9) ~ "Arriere_Droite",
place %in% c(4, 7) ~ "Arriere_Gauche",
place %in% c(5, 8) ~ "Arriere_Milieu",
)
)
# Afficher un aperçu des données après recodage
vroum_place <- vroum_place %>%
mutate(place = place_recoded) %>% # Mettre à jour `place`
select(-place_recoded) %>% # Supprimer `place_recoded`
drop_na(place)%>%
distinct(id_accident, .keep_all = TRUE) vroum_grv10 <- vroum %>%
mutate(
Gravite = case_when(
grav == 1 ~ "Indemne",
grav == 2 ~ "Tué",
grav == 3 ~ "Hospitalisé",
grav == 4 ~ "Blessé_Léger",
TRUE ~ "Autre" # Si d'autres catégories existent
)
)
# Afficher un aperçu des données après recodage
vroum_grv10 <- vroum_grv10 %>%
mutate(grav = Gravite) %>%
select(-Gravite)
vroum_lum <- vroum_grv10 %>%
mutate(
lumo = case_when(
lum == 1 ~"Plein jour",
lum == 2 ~ "Crépuscule ou aube",
lum == 3 ~ "Nuit sans éclairage public",
lum == 4 ~ "Nuit avec éclairage public non allumé",
lum==5 ~ "Nuit avec éclairage public allumé"
)
)
# Afficher un aperçu des données après recodage
vroum_lum <- vroum_lum %>%
mutate(lum = lumo) %>% # Mettre à jour `place`
select(-lumo) %>% # Supprimer `place_recoded`
drop_na(lum)%>%
distinct(id_accident, .keep_all = TRUE) vroum_grv2 <- vroum %>%
mutate(
Gravite = case_when(
grav == 1 ~ "Indemne",
grav == 2 ~ "Tué",
grav == 3 ~ "Hospitalisé",
grav == 4 ~ "Blessé Léger",
TRUE ~ "Autre" # Si d'autres catégories existent
)
)
# Afficher un aperçu des données après recodage
vroum_grv2 <- vroum_grv2%>%
mutate(grav = Gravite) %>%
select(-Gravite)
vroum_atm <- vroum_grv2 %>%
mutate(
atmo = case_when(
atm == 1 ~ "Normale",
atm == 2 ~ "Pluie légère",
atm == 3 ~ "Pluie forte",
atm == 4 ~ "Neige-grèle",
atm == 5 ~ "Brouillard-fumé",
atm == 6 ~ "Vent fort- tempète",
atm == 7 ~ "Temps éblouissant",
atm == 8 ~ "Temps couvert",
atm == 9 ~ "Autres",
)
)
vroum_atm <- vroum_atm %>%
mutate(atm = atmo) %>% # Renommer la colonne 'atmo' en 'atm'
select(-atmo) %>% # Supprimer la colonne 'atmo'
drop_na(atm) %>% # Supprimer les lignes où 'atm' est NA
distinct(id_accident, .keep_all = TRUE) # Conserver une seule ligne par 'id_accident'# 1. Construire la colonne date complète si nécessaire
vroum_filtered_unique <- vroum_filtered_unique %>%
mutate(
date_complete = as.Date(paste("2023", mois, jour, sep = "-"), format = "%Y-%m-%d")
)
# 2. Créer une colonne pour le mois complet
vroum_filtered_unique <- vroum_filtered_unique %>%
mutate(
mois_complete = as.Date(format(date_complete, "%Y-%m-01"))
)
# 3. Compter les trajets par type et mois
trajet_par_mois <- vroum_filtered_unique %>%
group_by(mois_complete, trajet) %>%
summarise(nombre = n(), .groups = 'drop')Présentation des données
Notre dashboard permet de regrouper les visualisations statistiques que nous avons réalisé sur la base des accidents corporels de la circulation routière en France pour l’année 2023 rendue publique par l’état sur data.gouv : https://www.data.gouv.fr/fr/datasets/bases-de-donnees-annuelles-des-accidents-corporels-de-la-circulation-routiere-annees-de-2005-a-2023/
Cette première page présente la répartition des accidents dans le temps, dans l’espace, ainsi que les caractéristiques des personnes impliquées.
Etude du Contexte des accidents
Répartition annuelle
# Exemple de DataFrame
vroum_cal <- vroum %>%
mutate(
# Créer une colonne de date complète
date_decl = make_date(year = an, month = mois, day = jour),
# Calculer le jour (numérique)
jour = day(date_decl),
# Jour de la semaine (nom complet)
journee = wday(date_decl, label = TRUE, abbr = FALSE),
# Mois (nom complet, non abrégé)
mois = month(date_decl, label = TRUE, abbr = FALSE),
# Numéro de la semaine dans le mois
wotm = ceiling(day(date_decl) / 7)
)
heatmap <- vroum_cal %>%
group_by(date = date_decl, journee, jour, mois, annee = 2023, wotm) %>%
summarise(nb = n_distinct(Num_Acc))## `summarise()` has grouped output by 'date', 'journee', 'jour', 'mois', 'annee'.
## You can override using the `.groups` argument.heatmap <- heatmap %>%
mutate(journee = factor(journee, levels = c("lundi", "mardi", "mercredi", "jeudi", "vendredi", "samedi", "dimanche")))
# Palette de couleurs
pal <- wes_palette("Zissou1", 100, type = "continuous")
# Ajustement de la mise en page pour afficher tous les mois
ggplot(heatmap, aes(wotm, journee, fill = nb)) +
geom_tile(colour = "white") +
facet_wrap(~ mois, nrow = 2, scales = "free_x") + # Utilisation de facet_wrap avec 2 lignes
labs(
fill = "Nombre d'accident",
x = "Semaine du mois",
y = "Journée",
title = "Nombre d'accident corporelle en 2023"
) +
scale_fill_gradientn(colours = pal) +
theme_bw() +
theme(
strip.text = element_text(size = 12, face = "bold"), # Améliorer la lisibilité des titres de facette
axis.text.x = element_text(angle = 45, hjust = 1) # Inclinaison des labels de l'axe X pour éviter l'encombrement
)
Répartition horaire
# Transformation de la colonne hrmn
vroum <- vroum %>%
mutate(
# Convertir hrmn en format heures, minutes, secondes
time = as.POSIXct(hrmn, format = "%H:%M:%S"),
hour = as.numeric(format(time, "%H")), # Extraire les heures
minute = as.numeric(format(time, "%M")), # Extraire les minutes
second = as.numeric(format(time, "%S")) # Extraire les secondes
) %>%
mutate(
# Arrondir l'heure selon les règles données
hour_adjusted = ifelse(
minute > 29 | (minute == 29 & second >= 30),
(hour + 1) %% 24, # Arrondir vers le haut, modulo 24 pour les heures > 23
hour
)
)
# Comptage du nombre d'accidents par heure arrondie
accidents_par_heure <- vroum %>%
group_by(hour_adjusted) %>%
summarise(nombre_accidents = n_distinct(Num_Acc)) %>%
arrange(hour_adjusted)
# Graphique en coordonnées polaires avec la palette "Paired"
g_bp.5 <- ggplot(data = accidents_par_heure,
aes(x = factor(hour_adjusted), y = nombre_accidents, group = 1)) +
geom_point(stat = 'identity', color = brewer.pal(12, "Paired")[2], size = 2) + # Point avec couleur de la palette "Paired"
geom_line(color = brewer.pal(12, "Paired")[2], size = 2) + # Ligne avec couleur de la palette "Paired"
coord_polar(start = -pi * 1/24) + # Coordonnées polaires
labs(
title = "Décompte des accidents par heure",
x = "Heure",
y = "Nombre d'accidents"
) +
theme_bw() +
theme(
plot.title = element_text(size = 14, hjust = 0.5),
axis.title.x = element_text(size = 12),
axis.title.y = element_text(size = 12),
axis.text = element_text(size = 10)
)## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.# Affichage du graphique
g_bp.5
Répartition par sexe
# Exclure les valeurs invalides et calculer l'âge
vroum_sexe <- vroum %>%
filter(sexe %in% c(1, 2)) %>% # Garder uniquement les valeurs valides pour sexe
mutate(age = 2023 - an_nais) %>% # Calculer l'âge
filter(!is.na(age)) # Exclure les NA dans les âges
# Regrouper par âge exact et par sexe
pyramide_data <- vroum_sexe %>%
group_by(age, sexe) %>%
summarise(nombre = n(), .groups = "drop") %>%
mutate(nombre = ifelse(sexe == 1, -nombre, nombre)) # Négatif pour les hommes
ggplot(pyramide_data, aes(x = age, y = nombre, fill = factor(sexe))) +
geom_bar(stat = "identity", width = 1) +
scale_y_continuous(labels = abs) + # Afficher les valeurs absolues sur l'axe Y
labs(
title = "Nombre d'accident en fonction de l'age et du sexe des personnes impliquées",
x = "Âge",
y = "Nombre d'accidents",
fill = "Sexe"
) +
scale_fill_manual(
values = c("#a6cee3", "#fb9a99"), # Couleur 1 pour hommes (#a6cee3), couleur 5 pour femmes (#fb9a99)
labels = c("Hommes", "Femmes")
) +
theme_minimal() +
theme(
plot.title = element_text(size = 16, hjust = 0.5),
axis.text.x = element_text(size = 12),
axis.text.y = element_text(size = 12),
axis.title.x = element_text(size = 14),
axis.title.y = element_text(size = 14),
legend.title = element_text(size = 12),
legend.text = element_text(size = 10)
)
# Exclure les valeurs invalides et calculer l'âge
vroum_passager <- vroum %>%
mutate(
place_recoded = case_when(
place == 1 ~ "Conducteur",
place %in% c(2,3,4,5,6,7,8,9) ~ "Passager"
)
)
vroum_passager<-vroum_passager%>%
drop_na(place_recoded)
# Transformer la base de données en comptant distinctement les accidents
donnees_donut <- vroum_passager %>%
group_by(place_recoded) %>%
summarise(count = n_distinct(Num_Acc)) %>%
ungroup() %>%
mutate(
fraction = count / sum(count),
ymax = cumsum(fraction),
ymin = c(0, head(ymax, n = -1)),
labelPosition = (ymax + ymin) / 2,
label = paste0(place_recoded, "\nAccidents: ", count)
)
# Créer le graphique en donut
ggplot(donnees_donut, aes(ymax = ymax, ymin = ymin, xmax = 4, xmin = 3, fill = place_recoded)) +
geom_rect() +
geom_label(x = 3.5, aes(y = labelPosition, label = label), size = 6) +
scale_fill_brewer(palette = "Paired") +
coord_polar(theta = "y") +
xlim(c(2, 4)) +
theme_void() +
theme(legend.position = "none") +
ggtitle("Répartition des accidents entre conducteurs et passagers")
Répartition géographique
# Calculer le nombre d'accidents par département
accidents_par_dep <- vroum %>%
group_by(dep) %>%
summarise(nombre_accidents = n_distinct(Num_Acc))
# Charger la carte des départements
france_departements <- st_read("https://france-geojson.gregoiredavid.fr/repo/departements.geojson", quiet = TRUE)
# Assurez-vous que les codes départements sont comparables (format chaîne de caractères)
accidents_par_dep$dep <- as.character(accidents_par_dep$dep)
# Fusionner les données des accidents avec la carte géographique
france_accidents_map <- france_departements %>%
left_join(accidents_par_dep, by = c("code" = "dep"))
# Générer une palette limitée aux 6 premières couleurs de "Paired"
paired_colors_limited <- colorRampPalette(brewer.pal(6, "Paired"))(100)
# Créer une heatmap avec leaflet en utilisant "Paired"
leaflet(france_accidents_map) %>%
addTiles() %>%
addPolygons(
fillColor = ~colorNumeric(paired_colors_limited, nombre_accidents)(nombre_accidents),
weight = 1, color = "white", fillOpacity = 0.7,
popup = ~paste("Département: ", nom, "<br>",
"Nombre d'accidents: ", nombre_accidents)
) %>%
addLegend(
pal = colorNumeric(paired_colors_limited, france_accidents_map$nombre_accidents),
values = france_accidents_map$nombre_accidents,
title = "Nombre d'accidents",
opacity = 0.7
)Analyse des critères qui impactent la gravité
Contexte
Cette seconde page présente une analyse statistique de la gravité de l’incident pour les personnes impliquées selon différents critères.
Répartition géographique
# Calcul des accidents par département et gravité
accidents_par_dep_gravite <- vroum %>%
group_by(dep, grav) %>%
summarise(nombre_accidents = n_distinct(id_accident), .groups = "drop")
# Charger les données géographiques des départements français
departements_geojson <- st_read("https://france-geojson.gregoiredavid.fr/repo/departements.geojson", quiet = TRUE)
# Extraire les centroides des départements
departements_geojson <- departements_geojson %>%
mutate(centroid = st_centroid(geometry)) %>%
mutate(
x = st_coordinates(centroid)[, 1],
y = st_coordinates(centroid)[, 2]
)
# Définir les couleurs personnalisées
custom_colors <- c(
"Indemne" = "#FDBF6F",
"Blessé léger" = "#FF7F00",
"Blessé hospitalisé" = "#FB9A99",
"Tué" = "#E31A1C"
)
# Fonction pour créer une carte Bubble Map pour une gravité spécifique
create_bubble_map <- function(gravite_label, gravite_code, color) {
# Filtrer les données pour la gravité spécifique
filtered_data <- accidents_par_dep_gravite %>%
filter(grav == gravite_code)
# Fusionner les données géographiques avec les données d'accidents
departements_accidents_map <- departements_geojson %>%
left_join(filtered_data, by = c("code" = "dep"))
# Créer la carte avec ggplot2
ggplot(departements_accidents_map) +
geom_sf(fill = "white", color = "gray", size = 0.2) + # Carte des départements
geom_point(aes(x = x, y = y, size = nombre_accidents), color = color, alpha = 0.7) + # Bulles
scale_size_continuous(name = "Nombre d'accidents", range = c(1, 7)) + # Taille des cercles
theme_void() +
labs(title = paste(gravite_label)) +
theme(
plot.title = element_text(size = 14, face = "bold", hjust = 0.5),
legend.position = "bottom"
)
}
# Gravités à mapper
gravites <- list(
"Indemne" = 1,
"Blessé léger" = 4,
"Blessé hospitalisé" = 3,
"Tué" = 2
)
# Générer les Bubble Maps pour chaque gravité avec les couleurs personnalisées
maps <- mapply(function(label, code, color) {
create_bubble_map(label, code, custom_colors[label])
}, names(gravites), gravites, custom_colors[names(gravites)], SIMPLIFY = FALSE)
# Organiser les cartes en une disposition 2x2
grid.arrange(grobs = maps, ncol = 2)
Répartition de la gravité des accidents selon le motif de déplacement
# 1. Filtrer les données pour exclure les trajets non renseignés (0 et -1)
vroum_filtered <- vroum %>%
filter(trajet != 0 & trajet != -1)
# 2. Remplacer les valeurs de trajet par leur signification réelle
vroum_filtered <- vroum_filtered %>%
mutate(trajet = case_when(
trajet == 1 ~ "Domicile – travail",
trajet == 2 ~ "Domicile – école",
trajet == 3 ~ "Courses – achats",
trajet == 4 ~ "Utilisation professionnelle",
trajet == 5 ~ "Promenade – loisirs",
trajet == 9 ~ "Autre",
TRUE ~ "Inconnu" # Au cas où
))
# 3. Remplacer les valeurs de gravité par leur signification réelle
vroum_filtered <- vroum_filtered %>%
mutate(grav = case_when(
grav == 1 ~ "Indemne",
grav == 2 ~ "Tué",
grav == 3 ~ "Blessé hospitalisé",
grav == 4 ~ "Blessé léger",
TRUE ~ "Inconnu" # Au cas où
))
# Définir les couleurs personnalisées
custom_colors <- c(
"#FDBF6F",
"#FF7F00",
"#FB9A99",
"#E31A1C"
)
# 3. S'assurer qu'il n'y a pas de doublons dans les clés (id_usager et trajet)
vroum_filtered_unique <- vroum_filtered %>%
distinct(id_usager, trajet, .keep_all = TRUE)
# 4. Comptage par combinaison unique d'id_usager, trajet et gravité
grav_trajet_summary <- vroum_filtered_unique %>%
group_by(id_usager, trajet, grav) %>%
summarise(count = n(), .groups = 'drop')
# 1. Créer le tableau récapitulatif (pivot) avec les totaux par trajet et gravité
pivot_table <- grav_trajet_summary %>%
group_by(trajet, grav) %>%
summarise(total = sum(count), .groups = 'drop') %>%
pivot_wider(names_from = grav, values_from = total, values_fill = list(total = 0))
# 2. Ajouter une colonne "total" pour chaque ligne (somme des différentes gravités)
pivot_table <- pivot_table %>%
mutate(total = rowSums(select(., -trajet), na.rm = TRUE))
# 3. Calculer les pourcentages par rapport au total de chaque ligne
pivot_table_percentage <- pivot_table %>%
mutate(across(-c(trajet, total), ~ round(. / total, 2), .names = " {.col}"))
# 4. Ne conserver que les colonnes "trajet", "total" et les pourcentages
pivot_table_percentage <- pivot_table_percentage %>%
select(trajet, total, starts_with(" "))
pivot_table_long <- pivot_table_percentage %>%
pivot_longer(cols = -trajet, names_to = "grav", values_to = "total") %>%
filter(grav != "total", trajet != "total")
# Définir les couleurs basées sur la palette "Accent"
accent_colors <- brewer.pal(6, "Dark2") # Nombre de couleurs = nombre de trajets
highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Histogramme présentant la répartition (en %) du type de gravité par trajet") %>%
hc_xAxis(categories = unique(pivot_table_long$trajet)) %>%
hc_yAxis(title = list(text = "Répartition des accidents (en %)")) %>%
hc_colors(accent_colors) %>% # Utilisation des couleurs "Accent"
hc_add_series(data = pivot_table_long %>%
filter(grav == " Blessé hospitalisé") %>%
group_by(trajet) %>%
summarise(total = sum(total)) %>%
pull(total), name = "Blessé hospitalisé", stack = "gravité",color=custom_colors[3]) %>%
hc_add_series(data = pivot_table_long %>%
filter(grav == " Blessé léger") %>%
group_by(trajet) %>%
summarise(total = sum(total)) %>%
pull(total), name = "Blessé léger", stack = "gravité",color=custom_colors[2]) %>%
hc_add_series(data = pivot_table_long %>%
filter(grav == " Tué") %>%
group_by(trajet) %>%
summarise(total = sum(total)) %>%
pull(total), name = "Tué", stack = "gravité",color=custom_colors[4]) %>%
hc_add_series(data = pivot_table_long %>%
filter(grav == " Indemne") %>%
group_by(trajet) %>%
summarise(total = sum(total)) %>%
pull(total), name = "Indemne", stack = "gravité",color=custom_colors[1])Conditions de l’accident
Répartition de la gravité des accidents selon les conditions atmosphérique
# Préparer les données avec des proportions
vroum_prop_grid <- vroum_atm %>%
group_by(atm, grav) %>%
summarise(count = n(), .groups = "drop") %>%
group_by(atm) %>%
mutate(
proportion = count / sum(count),
total_squares = round(proportion * 100) # Chaque situation sera divisée en 100 carrés
) %>%
ungroup()
# Corriger pour ne pas dépasser 100 carrés
vroum_prop_grid <- vroum_prop_grid %>%
group_by(atm) %>%
mutate(
diff = sum(total_squares) - 100, # Calculer l'excès de carrés
total_squares = ifelse(row_number() == n() & diff > 0, total_squares - diff, total_squares) # Réduire l'excès sur la dernière ligne
) %>%
ungroup()
# Créer des positions pour chaque carré
vroum_grid <- vroum_prop_grid %>%
group_by(atm) %>%
mutate(
start = cumsum(lag(total_squares, default = 0)) + 1,
end = cumsum(total_squares)
) %>%
rowwise() %>%
mutate(grid = list(seq(start, end))) %>%
unnest(grid) %>%
mutate(
x = (grid - 1) %% 10, # Colonnes pour former une grille de 10x10
y = (grid - 1) %/% 10 # Lignes pour former une grille de 10x10
) %>%
ungroup()
# Créer le graphique
ggplot(vroum_grid, aes(x = x, y = y, fill = grav)) +
geom_tile(color = "white") +
facet_wrap(~ atm, nrow = 2) +
scale_fill_manual(
values = c("Indemne" = "#FDBF6F",
"Blessé Léger" = "#FF7F00",
"Hospitalisé" = "#FB9A99",
"Tué" = "#E31A1C")
) +
coord_fixed() +
theme_minimal() +
labs(
title = "Répartition des accidents par situation atmosphérique et gravité",
x = NULL,
y = NULL,
fill = "Gravité"
) +
theme(
strip.text = element_text(face = "bold"),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank()
)
# Définir des couleurs personnalisées
custom_colors <- c(
"Indemne" = "#FDBF6F",
"Blessé Léger" = "#FF7F00",
"Hospitalisé" = "#FB9A99",
"Tué" = "#E31A1C"
)
# Créer un tableau de comptage par type d'atmosphère et gravité
data_summary <- vroum_atm %>%
group_by(atm, grav) %>%
summarise(count = n(), .groups = "drop") # Compter les accidents par catégorie
# Créer le graphique
plot_horizontal <- ggplot(data_summary, aes(x = count, y = atm, fill = grav)) +
geom_bar(stat = "identity", position = "stack") + # Barres empilées
scale_x_continuous(labels = comma_format()) + # Format des nombres avec des séparateurs
scale_fill_manual(values = custom_colors, name = "Gravité") + # Couleurs personnalisées
theme_bw() +
labs(
title = "Nombre d'accidents par condition atmosphérique et gravité",
x = "Nombre d'accidents",
y = "Condition atmosphérique"
) +
theme(
plot.title = element_text(size = 12, face = "bold", hjust = 0.5),
axis.text.y = element_text(size = 10), # Taille des étiquettes sur l'axe Y
axis.text.x = element_text(size = 10), # Taille des étiquettes sur l'axe X
legend.position = "right"
)
# Afficher le graphique
print(plot_horizontal)
Répartition de la gravité des accidents selon la luminosité
# 1. Filtrer pour enlever les -1 dans les colonnes lum et grav
vroum_lum <- vroum %>%
filter(lum != -1, grav != -1) # Exclusion des valeurs -1
# 2. Remplacer les valeurs de lum et grav par leurs libellés
vroum_lum <- vroum_lum %>%
mutate(
lum = case_when(
lum == 1 ~ "Plein jour",
lum == 2 ~ "Crépuscule ou aube",
lum == 3 ~ "Nuit sans éclairage public",
lum == 4 ~ "Nuit avec éclairage public non allumé",
lum == 5 ~ "Nuit avec éclairage public allumé",
TRUE ~ "Inconnu" # Juste au cas où
),
grav = case_when(
grav == 1 ~ "Indemne",
grav == 2 ~ "Tué",
grav == 3 ~ "Blessé hospitalisé",
grav == 4 ~ "Blessé léger",
TRUE ~ "Inconnu" # Sécurité pour valeurs non prévues
)
)
# 3. Garder uniquement les lignes distinctes basées sur Num_Acc
vroum_lum <- vroum_lum %>%
distinct(Num_Acc, .keep_all = TRUE)
pivot_table_lum <- vroum_lum %>%
group_by(lum, grav) %>%
summarise(count = n(), .groups = 'drop')
pivot_table_lum <- pivot_table_lum %>%
group_by(lum) %>%
mutate(total_lum = sum(count)) %>%
ungroup() %>%
mutate(percentage = round(count / total_lum,2) ) # Calcul des pourcentages
# 4. Réorganiser les données en format long
pivot_table_long_lum_2 <- pivot_table_lum %>%
select(lum, grav, count) # Garder les colonnes lum, grav, percentage
# Assurez-vous que les couleurs sont définies
custom_colors <- c("#FDBF6F", "#E31A1C", "#FB9A99", "#FF7F00") # Exemple
# Vérification des catégories uniques pour l'axe X
categories <- unique(pivot_table_long_lum_2$lum)
# Génération du graphe
highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Nombre d'accidents par types de gravité selon la luminosité") %>%
hc_xAxis(categories = categories) %>%
hc_yAxis(title = list(text = "Nombre des accidents")) %>%
hc_add_series(
data = pivot_table_long_lum_2 %>% filter(grav == "Indemne") %>% pull(count),
name = "Indemne",
stack = "gravité",
color = custom_colors[1]
) %>%
hc_add_series(
data = pivot_table_long_lum_2 %>% filter(grav == "Tué") %>% pull(count),
name = "Tué",
stack = "gravité",
color = custom_colors[2]
) %>%
hc_add_series(
data = pivot_table_long_lum_2 %>% filter(grav == "Blessé hospitalisé") %>% pull(count),
name = "Blessé hospitalisé",
stack = "gravité",
color = custom_colors[3]
) %>%
hc_add_series(
data = pivot_table_long_lum_2 %>% filter(grav == "Blessé léger") %>% pull(count),
name = "Blessé léger",
stack = "gravité",
color = custom_colors[4]
) %>%
hc_colors(custom_colors)Répartition de la gravité des accidents selon la catégorie de route
# Préparation des données : Ajout des noms des catégories de route et gravité
catr_labels <- c(
"1" = "Autoroute",
"2" = "Route nationale",
"3" = "Route départementale",
"4" = "Voie communale",
"5" = "Hors réseau public",
"6" = "Parc de stationnement",
"7" = "Routes de métropole urbaine",
"9" = "Autre"
)
grav_labels <- c(
"1" = "Indemne",
"2" = "Tué",
"3" = "Blessé hospitalisé",
"4" = "Blessé léger"
)
data_prepared <- vroum %>%
count(catr, grav) %>% # Compte les occurrences pour chaque combinaison de catr et grav
group_by(catr) %>% # Groupement par catégorie de route
mutate(proportion = n / sum(n)) %>% # Calcul des proportions
ungroup() %>%
mutate(
catr = factor(catr, levels = c(1, 2, 3, 4, 5, 6, 7, 9), labels = catr_labels), # Ajout des noms des catégories de route
grav = factor(grav, levels = c(1, 2, 3, 4), labels = grav_labels) # Ajout des noms des gravités
) %>%
drop_na(catr)
# Couleurs spécifiques pour les catégories de gravité (numéros 5 à 8 de la palette "Paired")
custom_colors <- c("#FDBF6F", "#E31A1C", "#FB9A99", "#FF7F00") # Paired 5-8
# Graphique 1 : Proportions
plot_proportion <- ggplot(data_prepared, aes(x = catr, y = proportion, fill = grav)) +
geom_bar(stat = "identity", position = "stack") + # Barres empilées
scale_y_continuous(labels = scales::percent_format()) + # Affichage en pourcentage
scale_fill_manual(values = custom_colors, name = "Gravité") +
theme_bw() +
labs(
title = "Proportion des accidents par catégorie de route et gravité",
x = "Catégorie de route",
y = "Proportion"
) +
theme(
plot.title = element_text(size = 8, face = "bold", hjust = 0.5),
axis.text.x = element_text(angle = 45, hjust = 1), # Rotation des étiquettes de l'axe X
legend.position = "right"
)
# Graphique 2 : Nombres absolus
plot_count <- ggplot(data_prepared, aes(x = catr, y = n, fill = grav)) +
geom_bar(stat = "identity", position = "stack") + # Barres empilées
scale_y_continuous(labels = scales::comma_format()) + # Affichage des nombres
scale_fill_manual(values = custom_colors, name = "Gravité") +
theme_bw() +
labs(
title = "Nombre d'accidents par catégorie de route et gravité",
x = "Catégorie de route",
y = "Nombre d'accidents"
) +
theme(
plot.title = element_text(size = 8, face = "bold", hjust = 0.5),
axis.text.x = element_text(angle = 45, hjust = 1), # Rotation des étiquettes de l'axe X
legend.position = "right"
)
# Afficher les graphiques séparément
print(plot_proportion)
print(plot_count)
Répartition de la gravité des accidents selon la vitesse maximale
# 2. Remplacer les valeurs de gravité par leur signification réelle
vroum_filtered_vma <- vroum %>%
mutate(grav = case_when(
grav == 1 ~ "Indemne",
grav == 2 ~ "Tué",
grav == 3 ~ "Blessé hospitalisé",
grav == 4 ~ "Blessé léger",
TRUE ~ "Inconnu" # Au cas où
))%>%
filter(vma %in% c(30,50,70, 80,90, 110, 130))
# 3. Comptage par combinaison unique de gravité et vma
grav_vma_summary <- vroum_filtered_vma %>%
group_by(grav, vma) %>%
summarise(count = n(), .groups = 'drop')
# 4. Créer un tableau récapitulatif (pivot) pour avoir les total d'accidents par gravité et vma
grav_vma_table <- grav_vma_summary %>%
pivot_wider(names_from = vma, values_from = count, values_fill = list(count = 0))
# 5. Ajouter une colonne "total" pour chaque ligne (somme des différentes vitesses)
grav_vma_table <- grav_vma_table %>%
mutate(total = rowSums(select(., -grav), na.rm = TRUE))
# Afficher les résultats
print(grav_vma_table)## # A tibble: 4 × 9
## grav `30` `50` `70` `80` `90` `110` `130` total
## <chr> <int> <int> <int> <int> <int> <int> <int> <dbl>
## 1 Blessé hospitalisé 260 1820 764 3431 1022 369 433 8099
## 2 Blessé léger 2473 11869 2697 4067 3501 1676 879 27162
## 3 Indemne 6865 21109 3304 4756 3640 1810 1065 42549
## 4 Tué 56 353 122 713 229 75 83 1631# Conversion de grav_vma_table en format long sans la colonne "total"
grav_vma_long <- grav_vma_table %>%
select(-total) %>% # Exclut la colonne "total"
pivot_longer(cols = starts_with("50"):starts_with("130"), # Sélectionne les colonnes de vitesse
names_to = "vma", # La nouvelle colonne pour les valeurs de vitesse
values_to = "count") # La nouvelle colonne pour les comptes d'accidents
# Obtenez les couleurs de la palette "Accent" de RColorBrewer
colors_accent <- brewer.pal(7, "Paired") # 7 couleurs pour chaque VMA
# Créer un graphique avec des barres verticales (une par combinaison gravité-vitesse)
highchart() %>%
hc_chart(type = "column") %>%
hc_title(text = "Accidents par Gravité et Vitesse (VMA)") %>%
hc_xAxis(categories = unique(grav_vma_long$grav), title = list(text = "Gravité")) %>%
hc_yAxis(title = list(text = "Nombre d'Accidents")) %>%
hc_plotOptions(column = list(
dataLabels = list(enabled = FALSE), # Désactive les labels numériques sur les barres
pointPadding = 0.2, # L'espace entre les groupes de barres
groupPadding = 0.1, # L'espace entre les barres de la même gravité
stacking = FALSE, # Empêche l'empilement des barres
borderWidth = 1 # Ajoute une bordure pour mieux distinguer les barres
)) %>%
hc_add_series(
data = grav_vma_long %>% filter(vma == 30) %>% pull(count),
name = "30 km/h",
color = colors_accent[1] # Utilise la première couleur de la palette "Accent"
) %>%
hc_add_series(
data = grav_vma_long %>% filter(vma == 50) %>% pull(count),
name = "50 km/h",
color = colors_accent[2] # Utilise la deuxième couleur de la palette "Accent"
) %>%
hc_add_series(
data = grav_vma_long %>% filter(vma == 70) %>% pull(count),
name = "70 km/h",
color = colors_accent[3] # Utilise la troisième couleur de la palette "Accent"
) %>%
hc_add_series(
data = grav_vma_long %>% filter(vma == 80) %>% pull(count),
name = "80 km/h",
color = colors_accent[4] # Utilise la quatrième couleur de la palette "Accent"
) %>%
hc_add_series(
data = grav_vma_long %>% filter(vma == 90) %>% pull(count),
name = "90 km/h",
color = colors_accent[5] # Utilise la cinquième couleur de la palette "Accent"
) %>%
hc_add_series(
data = grav_vma_long %>% filter(vma == 110) %>% pull(count),
name = "110 km/h",
color = colors_accent[6] # Utilise la sixième couleur de la palette "Accent"
) %>%
hc_add_series(
data = grav_vma_long %>% filter(vma == 130) %>% pull(count),
name = "130 km/h",
color = colors_accent[7] # Utilise la septième couleur de la palette "Accent"
) %>%
hc_tooltip(
shared = FALSE, # Affiche uniquement la série survolée
pointFormat = "<b>{point.y}</b> accidents"
) %>%
hc_legend(
enabled = TRUE,
title = list(text = "Vitesse (VMA)"),
align = "center",
verticalAlign = "top",
layout = "horizontal"
)# Définir les couleurs personnalisées
custom_colors <- c(
"Indemne" = "#FDBF6F",
"Blessé Léger" = "#FF7F00",
"Hospitalisé" = "#FB9A99",
"Tué" = "#E31A1C"
)
# Préparer les données
grav_labels <- c(
"1" = "Indemne",
"2" = "Tué",
"3" = "Hospitalisé",
"4" = "Blessé Léger"
)
filtered_vma <- c(30, 50, 70, 80, 90, 110, 130)
data_prepared <- vroum %>%
filter(vma %in% filtered_vma) %>%
group_by(vma, grav) %>%
summarise(nb = n(), .groups = "drop") %>%
mutate(
grav = factor(grav, levels = 1:4, labels = grav_labels), # Ajouter les labels de gravité
vma = factor(vma, levels = filtered_vma) # S'assurer de l'ordre des vitesses maximales
)
# Créer le graphique ggstream
ggplot(data_prepared, aes(x = vma, y = nb, fill = grav, group = grav)) +
geom_stream(type = "proportional", alpha = 0.8) + # Flux proportionnel
scale_fill_manual(values = custom_colors, name = "Gravité") + # Palette personnalisée
labs(
title = "Répartition des accidents par gravité et par vitesse maximale",
x = "Vitesse maximale (vma)",
y = "Proportion des accidents"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 16, face = "bold", hjust = 0.5),
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "right"
) +
guides(fill = guide_legend(title.position = "top", title.hjust = 0.5)) # Légende centrée
Répartition de la gravité des accidents selon le type de terrain
# Définir des couleurs personnalisées
custom_colors <- c(
"Indemne" = "#FDBF6F",
"Blessé léger" = "#FF7F00",
"Blessé hospitalisé" = "#FB9A99",
"Tué" = "#E31A1C"
)
# Calcul des pourcentages par colonne (prof)
comptage_grav_prof <- comptage_grav_prof %>%
group_by(prof) %>%
mutate(pourcentage = comptage / sum(comptage) * 100) %>%
ungroup()
# Création du graphique à bulles avec ggplot2
bubble_plot <- ggplot(comptage_grav_prof, aes(x = prof, y = grav, size = comptage, color = grav)) +
geom_point(alpha = 0.8) + # Alpha pour l'effet de transparence
geom_text(
aes(label = paste0(round(pourcentage, 1), "%")),
color = "brown", # Couleur des étiquettes
size = 4, # Taille des étiquettes
vjust = -1 # Positionnement vertical
) +
scale_size_continuous(range = c(10, 50)) + # Ajuste la taille des bulles
scale_color_manual(values = custom_colors) + # Application des couleurs personnalisées
theme_minimal() + # Thème épuré
labs(
title = "Gravité des Accidents selon le Type de Terrain",
subtitle = "Pourcentages normalisés par type de terrain",
x = "Type de Terrain (prof)",
y = "Gravité de l'Accident",
size = "Nombre d'Accidents",
color = "Gravité"
) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(hjust = 0.5, size = 20),
plot.subtitle = element_text(hjust = 0.5, size = 14)
)
# Convertir le graphique ggplot en graphique interactif plotly
interactive_plot <- ggplotly(bubble_plot)
interactive_plotRépartition de la gravité des accidents selon le type d’intersection
# Définir les couleurs personnalisées
custom_colors <- c(
"Indemne" = "#FDBF6F",
"Tué" = "#E31A1C",
"Blessé hospitalisé" = "#FB9A99",
"Blessé léger" = "#FF7F00"
)
# Préparation des données : noms des intersections et gravité
intersection_labels <- c(
"1" = "Hors intersection",
"2" = "Intersection en X",
"3" = "Intersection en T",
"4" = "Intersection en Y",
"5" = "Intersection à plus de 4 branches",
"6" = "Giratoire",
"7" = "Place",
"8" = "Passage à niveau",
"9" = "Autre intersection"
)
grav_labels <- c(
"1" = "Indemne",
"2" = "Tué",
"3" = "Blessé hospitalisé",
"4" = "Blessé léger"
)
# Préparer les données pour les graphiques
data_prepared <- vroum %>%
count(int, grav) %>% # Compte les occurrences pour chaque combinaison de int et grav
group_by(int) %>% # Groupement par type d’intersection
mutate(proportion = n / sum(n)) %>% # Calcul des proportions
ungroup() %>%
mutate(
int = factor(int, levels = 1:9, labels = intersection_labels), # Ajout des noms des intersections
grav = factor(grav, levels = 1:4, labels = grav_labels) # Ajout des noms des gravités
) %>%
drop_na(int)
# Graphique 1 : Proportion
plot_proportion <- ggplot(data_prepared, aes(y = int, x = proportion, fill = grav)) +
geom_bar(stat = "identity", position = "stack") + # Barres empilées
scale_x_continuous(labels = percent_format()) + # Affichage en pourcentage
scale_fill_manual(values = custom_colors, name = "Gravité") + # Couleurs personnalisées
theme_bw() +
labs(
title = "Proportion des accidents par type d'intersection et gravité",
x = "Proportion",
y = "Type d'intersection"
) +
theme(
plot.title = element_text(size = 16, face = "bold", hjust = 0.5),
axis.text.y = element_text(size = 10),
legend.position = "right"
)
# Graphique 2 : Nombre absolu
plot_count <- ggplot(data_prepared, aes(y = int, x = n, fill = grav)) +
geom_bar(stat = "identity", position = "stack") + # Barres empilées
scale_x_continuous(labels = comma_format()) + # Affichage des nombres
scale_fill_manual(values = custom_colors, name = "Gravité") + # Couleurs personnalisées
theme_bw() +
labs(
title = "Nombre d'accidents par type d'intersection et gravité",
x = "Nombre d'accidents",
y = "Type d'intersection"
) +
theme(
plot.title = element_text(size = 16, face = "bold", hjust = 0.5),
axis.text.y = element_text(size = 10),
legend.position = "right"
)
# Afficher les graphiques séparément
print(plot_proportion)
print(plot_count)
Répartition de la gravité des accidents selon le type de courbe
# Définir les couleurs personnalisées
custom_colors <- c(
"Indemne" = "#FDBF6F",
"Tué" = "#E31A1C",
"Blessé hospitalisé" = "#FB9A99",
"Blessé léger" = "#FF7F00"
)
# 1. Filtrer les données pour exclure les lignes où plan == -1
vroum_plan <- vroum %>%
filter(plan != -1) # Supprime les lignes "Non renseigné"
# 2. Remplacer les valeurs de 'plan' par les descriptions avec leurs numéros
vroum_plan <- vroum_plan %>%
mutate(plan = case_when(
plan == 1 ~ "Partie rectiligne",
plan == 2 ~ "En courbe à gauche",
plan == 3 ~ "En courbe à droite",
plan == 4 ~ "En « S »",
TRUE ~ as.character(plan)
))
# 3. Remplacer les valeurs de 'grav' par les descriptions avec leurs numéros
vroum_plan <- vroum_plan %>%
mutate(grav = case_when(
grav == 1 ~ "Indemne",
grav == 2 ~ "Tué",
grav == 3 ~ "Blessé hospitalisé",
grav == 4 ~ "Blessé léger",
TRUE ~ as.character(grav)
))
# Calculer le total des accidents pour chaque type de plan
totals_by_plan <- vroum_plan %>%
group_by(plan) %>%
summarise(total_plan = n(), .groups = 'drop')
# Calculer les pourcentages pour chaque gravité par type de plan
vroum_plan_percentages <- vroum_plan %>%
group_by(plan, grav) %>%
summarise(comptage = n(), .groups = 'drop') %>%
left_join(totals_by_plan, by = "plan") %>%
mutate(percentage = round((comptage / total_plan) * 100, 1)) %>%
ungroup()
# Créer le graphique à bulles avec les pourcentages normalisés et étiquettes en marron
bubble_plot_with_brown_labels <- ggplot(vroum_plan_percentages, aes(x = plan, y = grav, size = comptage, color = grav)) +
geom_point(alpha = 0.8) +
geom_text(aes(label = paste0(percentage, "%")), vjust = -1.5, size = 3, color = "brown") + # Ajouter les étiquettes avec couleur marron
scale_size_continuous(range = c(5, 40)) +
scale_color_manual(values = custom_colors, name = "Gravité") + # Application des couleurs personnalisées
theme_minimal() +
labs(
title = "Répartition des Accidents selon le Tracé en Plan",
x = "Type de Tracé en Plan",
y = "Gravité de l'Accident",
size = "Nombre d'Accidents",
color = "Gravité"
) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
plot.title = element_text(hjust = 0.5, size = 20)
)
# Convertir en graphique interactif avec plotly
interactive_bubble_plot_with_brown_labels <- ggplotly(bubble_plot_with_brown_labels)
# Afficher le graphique interactif
interactive_bubble_plot_with_brown_labelsRépartition de la gravité selon la place dans le véhicule
# Résumer les données
sankey <- vroum_place %>%
group_by(Place = place, Gravite = grav) %>%
summarise(nb = n_distinct(id_accident), .groups = "drop") # Compter les Num_Acc
# Création des nœuds
nodes <- data.frame(name = unique(c(as.character(sankey$Place), as.character(sankey$Gravite))))
# Création des liens avec des indices source/cible
sankey <- sankey %>%
mutate(
IDsource = match(Place, nodes$name) - 1,
IDtarget = match(Gravite, nodes$name) - 1,
LinkGroup = Gravite # Utiliser `Gravite` pour grouper les fils (cible)
)
# Définir les couleurs spécifiques pour les nœuds
# Palette "Paired"
paired_colors <- brewer.pal(12, "Paired")
# Associer les couleurs spécifiées pour chaque catégorie
node_color_map <- data.frame(
name = c("Conducteur", "Avant", "Arriere_Droite", "Arriere_Gauche", "Arriere_Milieu",
"Indemne", "Tué", "Hospitalisé", "Blessé_Léger"),
color = c(
paired_colors[1], # Conducteur
paired_colors[2], # Avant
paired_colors[3], # Arrière Droite
paired_colors[4], # Arrière Gauche
paired_colors[10], # Arrière Milieu
paired_colors[7], # Indemne
paired_colors[6], # Tué
paired_colors[5], # Hospitalisé
paired_colors[8] # Blessé Léger
)
)
# Ajouter les couleurs au dataframe des nœuds
nodes <- nodes %>%
left_join(node_color_map, by = "name")
# Fonction JavaScript pour appliquer les couleurs des nœuds
colourScale <- JS(
paste0(
"d3.scaleOrdinal()
.domain([", paste(shQuote(nodes$name), collapse = ", "), "])
.range([", paste(shQuote(nodes$color), collapse = ", "), "])"
)
)
# Créer le graphique Sankey
sankeyGraph <- sankeyNetwork(
Links = sankey, # Liens
Nodes = nodes, # Nœuds
Source = "IDsource", # Indices source
Target = "IDtarget", # Indices cible
Value = "nb", # Poids des liens
NodeID = "name", # Nom des nœuds
LinkGroup = "LinkGroup", # Groupes pour les fils
fontSize = 12, # Taille de police
nodeWidth = 30, # Largeur des nœuds
colourScale = colourScale # Échelle de couleurs JS
)## Links is a tbl_df. Converting to a plain data frame.# Afficher le graphique
sankeyGraph# Step 1: Prepare data with proportions
vroum_prop_grid <- vroum_place %>%
group_by(place, grav) %>%
summarise(count = n(), .groups = "drop") %>%
group_by(place) %>%
mutate(
proportion = count / sum(count),
total_squares = floor(proportion * 100) # Use floor instead of round to prevent overflow
) %>%
ungroup()
# Step 2: Correct for leftover squares
vroum_prop_grid <- vroum_prop_grid %>%
group_by(place) %>%
mutate(
total_assigned = sum(total_squares),
leftover = 100 - total_assigned, # Calculate leftover squares
total_squares = ifelse(row_number() <= leftover, total_squares + 1, total_squares) # Distribute leftover squares
) %>%
ungroup()
# Step 3: Create grid positions for tiles
vroum_grid <- vroum_prop_grid %>%
group_by(place) %>%
mutate(
start = cumsum(lag(total_squares, default = 0)) + 1,
end = cumsum(total_squares)
) %>%
rowwise() %>%
mutate(grid = list(seq(start, end))) %>%
unnest(grid) %>%
mutate(
x = (grid - 1) %% 10, # Columns for a 10x10 grid
y = (grid - 1) %/% 10 # Rows for a 10x10 grid
) %>%
ungroup()
# Step 4: Create the plot
ggplot(vroum_grid, aes(x = x, y = y, fill = grav)) +
geom_tile(color = "white") +
facet_wrap(~ place, nrow = 2) +
scale_fill_manual(
values = c("Indemne" = "#FDBF6F",
"Blessé_Léger" = "#FF7F00",
"Hospitalisé" = "#FB9A99",
"Tué" = "#E31A1C")
) +
coord_fixed() +
theme_minimal() +
labs(
title = "Répartition des accidents selon la place dans le véhicule",
x = NULL,
y = NULL,
fill = "Gravité"
) +
theme(
strip.text = element_text(face = "bold"),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank()
)
Répartition de la gravité des accidents par zone de choc sur la voiture
library(ggplot2)
library(ggridges)
library(dplyr)
# Définir les couleurs personnalisées
custom_colors <- c(
"Indemne" = "#FDBF6F",
"Blessé Léger" = "#FF7F00",
"Hospitalisé" = "#FB9A99",
"Tué" = "#E31A1C"
)
# Préparer les données pour le graphique
gravites_labels <- c(
"Indemne", "Tué", "Hospitalisé", "Blessé Léger"
)
choc_labels <- c(
"Avant", "Avant droit", "Avant gauche", "Arrière",
"Arrière droit", "Arrière gauche", "Côté droit",
"Côté gauche", "Chocs multiples"
)
# Préparer les données pour le graphique
gravite_choc_data <- vroum %>%
filter(grav >= 1 & grav <= 4 & choc >= 1 & choc <= 9) %>%
mutate(
grav_label = factor(grav, levels = 1:4, labels = gravites_labels),
choc_label = factor(choc, levels = 1:9, labels = choc_labels)
) %>%
count(choc_label, grav_label) %>%
group_by(choc_label) %>%
mutate(percentage = n / sum(n) * 100) # Calcul du pourcentage
# Créer un graphique en rose des vents
ggplot(gravite_choc_data, aes(x = choc_label, y = percentage, fill = grav_label)) +
geom_bar(stat = "identity", position = "stack", width = 1, color = "black") +
coord_polar(theta = "x") + # Transformation en graphique polaire
scale_fill_manual(
values = custom_colors, # Utiliser les couleurs personnalisées
name = "Gravité"
) +
labs(
title = "",
x = "",
y = "Pourcentage",
fill = "Gravité"
) +
theme_minimal(base_size = 14) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1), # Rotation des étiquettes de l'axe X
plot.title = element_text(hjust = 0.5, face = "bold"), # Centrer le titre
legend.position = "right" # Position de la légende
)
Page 3 : Analyse décès
Analyse spécifique aux décès
Décès par âge et sexe
# Calcul de l'âge à partir de l'année de naissance
vroum_bal <- vroum %>%
mutate(age = 2023 - an_nais) %>% # Calculer l'âge
filter(age >= 0 & age <= 120 & grav == 2) # Filtrer les âges aberrants et condition grav == 2
# Graphique empilé (bar chart)
stacked_bar <- ggplot(vroum_bal, aes(x = age, fill = as.factor(sexe))) +
geom_bar(position = "stack") + # Barres empilées
labs(
x = "Âge (années)",
y = "Nombre d'usagers",
fill = "Sexe",
title = ""
) +
scale_fill_manual(
values = c("1" = "#a6cee3", "2" = "#fb9a99"),
labels = c("1" = "Masculin", "2" = "Féminin")
) +
theme_minimal()
# Préparer les données pour le camembert
pie_data <- vroum_bal %>%
group_by(sexe) %>%
summarise(count = n()) %>%
mutate(percentage = count / sum(count) * 100) # Calculer les pourcentages
# Camembert (pie chart)
pie_chart <- ggplot(pie_data, aes(x = "", y = count, fill = as.factor(sexe))) +
geom_bar(stat = "identity", width = 1) +
coord_polar("y") +
geom_text(aes(label = paste0(round(percentage, 1), "%")),
position = position_stack(vjust = 0.5), size = 4) +
labs(
fill = "Sexe",
title = ""
) +
scale_fill_manual(
values = c("1" = "#a6cee3", "2" = "#fb9a99"),
labels = c("1" = "Masculin", "2" = "Féminin")
) +
theme_void() +
theme(legend.position = "bottom")
# Assembler les graphiques avec gridExtra sur une même ligne
grid.arrange(
stacked_bar,
pie_chart,
ncol = 2, # Deux colonnes
widths = c(2, 0.5) # Taille relative : le graphique empilé deux fois plus large
)
Décès par zone de choc
# Calcul des décès et pourcentages
death_counts <- vroum %>%
filter(grav == 2 & choc != -1 & choc != 0) %>%
count(choc) %>%
complete(choc = 1:9, fill = list(n = 0)) %>%
mutate(
percentage = n / sum(n) * 100,
choc_label = factor(choc, levels = 1:9, labels = c(
"Avant", "Avant droit", "Avant gauche", "Arrière",
"Arrière droit", "Arrière gauche", "Côté droit",
"Côté gauche", "Chocs multiples"
))
)
# Définir les positions pour les zones de choc
positions <- data.frame(
choc = 1:9,
x = c(90, 80, 80, 0, 3, 3, 45, 45, 45),
y = c(50, 70, 30, 50, 70, 30, 72, 23, 10)
)
# Fusionner les positions et les données des décès
death_counts <- death_counts %>%
left_join(positions, by = "choc")
# Charger l'image de la voiture
car_image <- png::readPNG("car_image.png") # Remplacez par le chemin réel de votre image
car_image_grob <- rasterGrob(car_image, interpolate = TRUE)
# Créer le graphique sans légende pour les zones de choc
ggplot(death_counts, aes(x = x, y = y)) +
annotation_custom(car_image_grob, xmin = 0, xmax = 100, ymin = 0, ymax = 100) +
geom_point(
aes(size = n, fill = factor(choc)), # Couleurs pour chaque choc
shape = 21,
color = "black",
alpha = 0.8
) +
geom_text(
aes(label = paste0(choc_label, "\n", n, " décès\n(", round(percentage, 1), "%)")),
vjust = 0.5, hjust = 0.5, size = 3.5, color = "black", fontface = "bold"
) +
scale_size_continuous(
range = c(5, 25), # Ajustement de l'échelle des tailles
name = "Nombre de décès"
) +
scale_fill_brewer(
palette = "Paired", # Utilisation de la palette "Paired"
name = "Zone de choc",
guide = "none" # Suppression de la légende des zones
) +
theme_void() + # Suppression des axes et grilles
theme(
plot.title = element_text(face = "bold", size = 14, hjust = 0.5),
legend.position = "right", # Légende uniquement pour la taille des cercles
legend.title = element_text(size = 10),
legend.text = element_text(size = 8)
) +
coord_fixed(ratio = 1) + # Maintenir les proportions
labs(
title = "Répartition des décès par zone de choc"
)
Répartition géographique des décès
vroum_grv6 <- vroum %>%
mutate(
Gravite = case_when(
grav == 2 ~ "Tué"
)
)
# Afficher un aperçu des données après recodage
vroum_grv6 <- vroum_grv6 %>%
mutate(grav = Gravite) %>%
select(-Gravite)%>%
drop_na(grav)
## Remove NA
df_map_dyn <- vroum_grv6 %>%
filter(vroum_grv6$lat != 0 & vroum_grv6$long !=0) %>%
distinct(id_accident, .keep_all = TRUE) # Conserver une seule ligne par 'id_accident'
# Transformer les données en spatial
mymap <- st_as_sf(df_map_dyn[1:1000, ], coords = c("long", "lat"),
crs = 4326,
na.fail = FALSE)
# Créer une palette de couleurs unique pour chaque catégorie de gravité
palette_gravite <- c(
"Tué" = "#E31A1C"
)
# Utiliser mapview pour afficher avec une couleur par gravité
mapview(mymap, cex = 2, layer.name = "Gravité",
zcol = "grav", # La colonne qui définit les catégories
col.regions = palette_gravite, # Appliquer la palette de couleurs
legend = TRUE,
map.types = "OpenStreetMap")Analyse corrélation décès port de la ceinture
# Filtrer les données et créer des colonnes supplémentaires
data_no_belt <- vroum %>%
mutate(
no_belt = !(secu1 == 1 | secu2 == 1 | secu3 == 1), # Vérifie l'absence de ceinture
grav_category = case_when(
grav == 2 ~ "Tués",
grav %in% c(1, 3, 4) ~ "Non tués"
),
passenger_position = case_when(
place %in% c(1, 2, 6) ~ "Avant", # Passagers avant
TRUE ~ "Arrière" # Passagers arrière
)
) %>%
filter(!is.na(grav_category) & !is.na(passenger_position)) # Exclure les valeurs non catégorisées
# Calcul des pourcentages par groupe et position
percentages <- data_no_belt %>%
group_by(grav_category, passenger_position) %>%
summarise(
total = n(), # Total dans chaque groupe
no_belt_count = sum(no_belt), # Nombre de personnes sans ceinture
.groups = "drop"
) %>%
mutate(
no_belt_percentage = (no_belt_count / total) * 100 # Calcul du pourcentage
)
# Créer un graphique avec étiquettes
ggplot(percentages, aes(x = passenger_position, y = no_belt_percentage, fill = grav_category)) +
geom_bar(stat = "identity", position = "dodge", width = 0.7) + # Position "dodge" pour distinguer les gravités
geom_text(
aes(
label = paste0(no_belt_count, " (", round(no_belt_percentage, 1), "%)"),
y = no_belt_percentage + 2 # Décalage pour positionner l'étiquette au-dessus des barres
),
position = position_dodge(width = 0.7), size = 3.5, color = "black"
) +
labs(
title = "",
x = "Position dans le véhicule",
y = "Pourcentage d'usagers sans ceinture",
fill = "Gravité"
) +
scale_fill_manual(values = c("Tués" = "#E31A1C", "Non tués" = "#fb9a99")) +
theme_minimal() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1) # Incliner les étiquettes
)